4. Proposed Solutions
Q1: Most Popular Locations
Using just the credit and loyalty card data, identify the most popular locations, and when they are popular. What anomalies do you see? What corrections would you recommend to correct these anomalies?
Generate an interactive bar graph in descending order using ggplot and plotly to determine the most popular locations.
popular_combine <- cc_loyalty_data %>%
group_by(location) %>%
summarize(total_count=n()) %>%
ggplot(aes(x=reorder(location, total_count),
y=total_count,
text = paste("Location :", location,"\n",
"Number of transactions:", total_count))) +
geom_bar(stat="identity", fill = "royalblue4") +
ggtitle("Combined Credit Card & Loyalty Transactions") +
labs(x = "Locations", y = "Transaction Count") +
coord_flip() +
theme_minimal()
ggplotly(popular_combine, tooltip = "text")
Based on the combined combined credit card and loyalty data, the most popular location is Katerina’s Cafe with a total of 256 transactions, followed by Hippokampos with 213 transactions and Guy’s Gyro with 187 transactions.
Generate an interactive heatmap using ggplot and plotly to determine the date and time when employees visit the locations.
day_location_count <- cc_loyalty_data %>%
count(location, day) %>%
rename(count = n)
popular_day_location <- ggplot(data = day_location_count,
aes(x=day, y=reorder(location, desc(location)),
fill = count,
text = paste("Location :", location,"\n",
"Day of week:", day,"\n",
"Number of transactions :", count))) +
geom_tile()+
scale_fill_gradient(low = "lightsteelblue1", high = "royalblue4") +
ggtitle("Combined Credit Card & Loyalty Transactions by Day") +
labs(x = "Day of the Week",y = "Locations") +
theme_minimal()
ggplotly(popular_day_location, tooltip = "text")
Based on the combined combined credit card and loyalty data, Brew’ve Been Served is popular on weekdays, Monday to Friday, with no transactions on weekend. Probably this location is only open weekday.
Guy’s Gyro, Hippokampos, and Katerina’s Cafe are very popular throughout the week, Sunday to Monday. Katerina’s Cafe is the most popular location on Saturday with a total of 42 transactions.
Some of the interesting transactions are U-Pump with 2 transactions only on Monday and Desafio Golf Course with only 9 transactions only on Sunday.
hour_location_count <- cc_loyalty_data %>%
count(location, hour) %>%
rename(count = n)
popular_hour_location <- ggplot(data = hour_location_count,
aes(x=hour, y=reorder(location, desc(location)),
fill = count,
text = paste("Location :", location,"\n",
"Hour of the Day:", hour,"\n",
"Number of transactions :", count))) +
geom_tile()+
scale_fill_gradient(low = "lightsteelblue1", high = "royalblue4") +
ggtitle("Combined Credit Card & Loyalty Transactions by Hour of Day") +
labs(x = "Hour of the Day",y = "Locations") +
theme_minimal()
ggplotly(popular_hour_location, tooltip = "text")
Based on the time of transaction, Brew’ve Been Served and Hallowed Grounds are popular in the morning around 7AM and 8AM. Most probably the employees visit the place before heading to the office.
Abila Zacharo, Bean There Done That, Brewed Awakenings, Gelatogalore, Guy’s Gyro, Hippokampos, Jack’s Magical Beans, Kalami Kafenion, Katerina’s Kafe, and Ouzera Elian are popular during lunch break around 12NN to 1PM.
Guy’s Gyro, Hippokampos, and Katerina’s Kafe are popular during dinner around 7PM and 8PM. Katerina’s Kafe has the highest transactions at 85 purchases at around 8PM.
Generate an interactive boxplot using plotly to determine the outliers and provide clues on some anomalies.
outlier <- plot_ly(data = cc_loyalty_data,
x = ~price,
color = I("royalblue4"),
alpha = 0.5,
boxpoints = "suspectedoutliers") %>%
add_boxplot(y = ~reorder(location, desc(location))) %>%
layout(title = "Combined Credit Card & Loyalty Transactions Outliers",
yaxis = list(title = "Locations"),
xaxis = list(title = "Price"))
outlier
Based on the price of transaction, it seems that there is unusual expensive purchase at Frydos Autosupply n More amount to 10,000. This is highly suspicious since the mean price for this location is only 161.96 with third quartile value of approximately 250.
Generate an interactive linegraph using plot_anomaly_diagnostics() of plotly to diagnose anomalous points in the cc_data purchase prices. Note that only locations with sufficient number of observations were selected for the anomaly diagnostics.
cc_data %>%
filter(location %in% c("Abila Airport",
"Albert's Fine Clothing",
"Carlyle Chemical Inc.",
"Chostus Hotel",
"Frydos Autosupply n' More",
"Gelatogalore",
"Nationwide Refinery",
"Stewart and Sons Fabrication")) %>%
group_by(location) %>%
plot_anomaly_diagnostics(timestamp, price,
.facet_ncol = 2,
.y_lab = "Price")
Based on the anomaly diagnostics, there are unusual purchases in Gelatogalore, Frydos Autosupply n’ More, Albert’s Fine Clothing, and Chostus Hotel. Again, the most expensive purchase is from Frydos Autosupply n More amounting to 10,000 on 2014-01-13 19:20:00.
The anomalies will not be removed or corrected. It will be kept in the data since it may lead to more clues in solving the challenge.
Q2: Anomalies in Vehicle, Credit Card and Loyalty Card Data
Add the vehicle data to your analysis of the credit and loyalty card data. How does your assessment of the anomalies in question 1 change based on this new data? What discrepancies between vehicle, credit, and loyalty card data do you find?
Generate an interactive heatmap using ggplot and plotly based on the amount of transactions with missing last4ccnum.
missing_last4ccnum <- cc_loyalty_data %>%
filter(is.na(last4ccnum))
na_last4ccnum <- ggplot(data = missing_last4ccnum,
aes(x=date, y=reorder(location, desc(location)),
fill = price,
text = paste("Location :", location,"\n",
"Date:", date,"\n",
"Total Amount of Transaction:", price))) +
geom_tile()+
scale_fill_gradient(low = "lightsteelblue1", high = "royalblue4") +
ggtitle("Transactions with Missing Credit Card Data by Date") +
labs(x = "Date of Transaction", y = "Locations") +
theme_minimal()
ggplotly(na_last4ccnum, tooltip = "text")
Based on the total amount of transactions with missing credit card, National Refinery has a transaction on 2014-01-08 with a price of 4367.63. Stewart and Sons Fabrication has a transaction on 2014-01-13 with a price of 4071.95 and another one on 2014-01-15 with a price of 4485.38.
The discrepancies may be due to employees who bought the items with cash instead of credit card but still used the loyalty card to redeem points or rewards.
Generate another interactive heatmap using ggplot and plotly based on the amount of transactions with missing loyaltynum.
missing_loyaltynum <- cc_loyalty_data %>%
filter(is.na(loyaltynum))
na_loyaltynum <- ggplot(data = missing_loyaltynum,
aes(x=date, y=reorder(location, desc(location)),
fill = price,
text = paste("Location :", location,"\n",
"Date:", timestamp,"\n",
"Total Amount of Transaction:", price))) +
geom_tile()+
scale_fill_gradient(low = "lightsteelblue1", high = "royalblue4") +
ggtitle("Transactions with Missing Loyalty Data by Date") +
labs(x = "Date of Transaction", y = "Locations") +
theme_minimal()
ggplotly(na_loyaltynum, tooltip = "text")
Based on the total amount of transactions with missing loyalty card, Frydos Autosupply n More has a transaction on 2014-01-13 19:20:00 with a price of 10,000.
The discrepancy is more suspicious since the person who bought the items did not use his loyalty card which may imply possible misuse of the credit card when making the transaction.
Add the gps and car data by creating a movement path from GPS points using the CarIDs as unique identifier. Filter the data around the time of transaction from 2014-01-13 19:00 to 21:00.
Plot the gps path on the background tourist map and identity which CarIDs are within the vicinity of Frydos Autosupply n More.
gps_path_selected_0113 <- gps_path_0113 %>%
filter(CarID %in% c("13" , "15", "16", "34"))
tmap_mode("view")
tm_shape(bgmap) +
tm_rgb(bgmap, r = 1,g = 2,b = 3,
alpha = NA,
saturation = 1,
interpolate = TRUE,
max.value = 255) +
tm_shape(gps_path_selected_0113) +
tm_lines() +
tm_facets(by = "CarID", ncol = 1)
From the gps paths, CarID “13” , “15”, “16”, “34” are within the vicinity of Frydos Autosupply n More during suspicions transaction amounting to the price of 10,000.
Create an interactive data table based on the joint gps and car and filter the date to 2014-01-13.
From the interactive table, all CarIDs identified are from the Security Department. Possibly, Isia Vann and Edvard Vann are relatives because of the same Last Name and working together as Perimeter Controller.
Q3: Owners of Credit Card and Loyalty Card
Can you infer the owners of each credit card and loyalty card? What is your evidence? Where are there uncertainties in your method? Where are there uncertainties in the data?
It is challenging to infer the owners of the credit card and loyalty card since there is no data field to join the credit card and gps data.
One possible approach to plot the gps path and check it against timestamp of the credit card transactions. This approach assumes that the person driving the car is the same person making the credit card transaction. Additionally, it assumes that the gps coordinates, timestamp as well as the credit location and timestamp are accurate.
To implement this proposed approach, it assumes the geospatial tracking software installed in the employees car will stop tracking if the vehicle is not moving. Borrowing from concept of ‘Point of Interest’ (POI) from Virginia Tech, POI is identified if the employee stops for more than 5 minutes.
Identify the POIs by computing the difference of gps timestamp. If the difference is greater than 5 minutes, it will be set to poi = TRUE.
gps_poi_sf <- car_gps_sf %>%
group_by(CarID) %>%
mutate(diff = timestamp - lag(timestamp, order_by=CarID)) %>%
mutate(poi = if_else(diff > 60*5, TRUE, FALSE)) %>%
filter(poi == TRUE) %>%
ungroup()
glimpse(gps_poi_sf)
Rows: 3,067
Columns: 11
$ timestamp <dttm> 2014-01-06 06:53:01, 2014-01-06 07:05:01, 2014-01~
$ CarID <fct> 4, 35, 4, 10, 34, 26, 20, 19, 18, 12, 32, 33, 3, 7~
$ date <dttm> 2014-01-06, 2014-01-06, 2014-01-06, 2014-01-06, 2~
$ day <ord> Mon, Mon, Mon, Mon, Mon, Mon, Mon, Mon, Mon, Mon, ~
$ hour <int> 6, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,~
$ geometry <POINT [°]> POINT (24.86419 36.07333), POINT (24.87336 3~
$ Deparment <chr> "Executive", "Executive", "Executive", "Executive"~
$ Title <chr> "SVP/CFO", "Environmental Safety Advisor", "SVP/CF~
$ FullName <chr> "Ingrid Barranco", "Willem Vasco-Pais", "Ingrid Ba~
$ diff <drtn> 1057 secs, 1920 secs, 1320 secs, 1980 secs, 1633 ~
$ poi <lgl> TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TR~Plot the POIs on the backgroup tourist map and identity the employee locations. From the Combined Credit Card & Loyalty Transactions by Hour of Day heatmap of Question 1, the earliest transaction is around 3:00 AM from Kronos Mart while the last transaction is 10:00 PM from Hippokampos. This information can be used to limit the number of POIs.
gps_poi_points <- gps_poi_sf %>%
filter(hour >= 3 & hour <= 23) %>%
select(timestamp,
CarID,
Deparment,
Title,
FullName)
tmap_mode("view")
tm_shape(bgmap) +
tm_rgb(bgmap, r = 1,g = 2,b = 3,
alpha = NA,
saturation = 1,
interpolate = TRUE,
max.value = 255) +
tm_shape(gps_poi_points) +
tm_dots(col = 'red', border.col = 'black', size = 1, alpha = 0.5, jitter = .8) +
tm_facets(by = "FullName", ncol = 1)
Create an interative data table based on the joint credit card and infer the owner based on the POI plot.
cc_owner <- cc_data %>%
select(timestamp, location, last4ccnum)
DT::datatable(cc_owner)
Finally, manually map the credit card transaction purchases timestamp against the POI map. This approach is very time consuming since it entails manual effort. As for most cases, the POI map may show certain points around the vicinity of the location but does not have any corresponding credit card purchases.
The owner of the loyalty card will be known after the credit card owner has been identified. As noted earlier, there is no one-to-one correspondence between the credit and loyalty card.
The heatmap below visualizes the number of transactions between specific credit card and loyalty card to know the highest likelihood of the loyalty card owner.
cc_loyal_count <- cc_loyalty_data %>%
group_by(last4ccnum,loyaltynum) %>%
summarise(count=n())
cc_loyal_correlate <- ggplot(data = cc_loyal_count,
aes(x=loyaltynum, y=as.factor(last4ccnum),
fill = count,
text = paste("Last 4 Credit Card Number :", last4ccnum,"\n",
"Loyalty Card Number:", loyaltynum,"\n",
"Number of transactions :", count))) +
geom_tile()+
scale_fill_gradient(low = "lightsteelblue1", high = "royalblue4") +
ggtitle("Correlation of Credit Card & Loyalty Card by Number of Transactions") +
labs(x = "Loyalty Card Number",y = "Credit Card Number") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 90))
ggplotly(cc_loyal_correlate, tooltip = "text")
From the heatmap, it can seen that certain combination of credit card number and loyalty card are most often used together. Example of which are 6901 and L9363 with 28 transactions; 7117 and L6417 also with 28 transactions.
Nevertheless, even for credit card 6901, there are still 9 transactions when loyalty card was not used. Similarly, credit card 7117 has 3 transactions when loyalty card was not used.
Q4: Relationships among GASTech Personnel
Given the data sources provided, identify potential informal or unofficial relationships among GASTech personnel. Provide evidence for these relationships.
Similar to question 3, identify the POIs by computing the difference of gps timestamp.
Afterwards, identify who are within ‘close contact’ of each employee based on the difference of their gps coordinates within the same time period.
This can help establish the relationship of GASTech personnel according to their meetings at the same place and at the same time.
gps_poi_network <- car_gps_data %>%
group_by(CarID) %>%
mutate(poi_diff = timestamp - lag(timestamp, order_by=CarID)) %>%
mutate(poi = if_else(poi_diff > 60*5, TRUE, FALSE)) %>%
filter(poi == TRUE) %>%
ungroup() %>%
mutate(lat_diff = lat - lag(lat, order_by=timestamp))%>%
mutate(long_diff = long - lag(long, order_by=timestamp)) %>%
mutate(close_contact = if_else(abs(lat_diff) <=0.001 & abs(long_diff) <=0.001, TRUE, FALSE))%>%
filter(close_contact == TRUE) %>%
ungroup()
glimpse(gps_poi_network)
Rows: 773
Columns: 15
$ timestamp <dttm> 2014-01-06 07:34:01, 2014-01-06 07:44:01, 201~
$ CarID <fct> 10, 12, 8, 13, 30, 22, 16, 107, 33, 10, 20, 19~
$ lat <dbl> 36.07333, 36.06365, 36.06365, 36.05408, 36.054~
$ long <dbl> 24.86418, 24.88593, 24.88594, 24.90125, 24.901~
$ date <dttm> 2014-01-06, 2014-01-06, 2014-01-06, 2014-01-0~
$ day <ord> Mon, Mon, Mon, Mon, Mon, Mon, Mon, Mon, Mon, M~
$ hour <int> 7, 7, 7, 8, 8, 8, 11, 11, 11, 11, 11, 11, 12, ~
$ Deparment <chr> "Executive", "Security", "Information Technolo~
$ Title <chr> "SVP/CIO", "Site Control", "IT Technician", "S~
$ FullName <chr> "Ada Campo-Corrente", "Hideki Cocinaro", "Luca~
$ poi_diff <drtn> 1980 secs, 1965 secs, 1307 secs, 2005 secs, 1~
$ poi <lgl> TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE~
$ lat_diff <dbl> -1.833e-05, -5.626e-05, -6.738e-05, -2.531e-05~
$ long_diff <dbl> 7.720e-06, 3.232e-05, 1.306e-05, 2.260e-06, -6~
$ close_contact <lgl> TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE~ employee_edges <- gps_poi_network %>%
group_by(date, hour)%>%
mutate(from = FullName) %>%
mutate(to = lead(FullName, order_by = timestamp)) %>%
ungroup() %>%
group_by(from,to) %>%
summarise(weight = n())
employee_nodes <- gps_poi_network %>%
select(FullName, Deparment, Title) %>%
rename(id = FullName) %>%
rename(group = Deparment) %>%
distinct()
visNetwork(employee_nodes,
employee_edges,
main = "Relationships among GASTech Personnel") %>%
visIgraphLayout(layout = "layout_with_fr") %>%
visEdges(arrows = "to",
smooth = list(enabled = TRUE,
type = "curvedCW")) %>%
visOptions(highlightNearest = TRUE,
nodesIdSelection = TRUE) %>%
visLegend() %>%
visLayout(randomSeed = 123)
The network diagram shows the ‘official’ relationship of employees based on their respective departments. It also show ‘unofficial’ relationship based on the number of their interactions.
From the network diagram, it can be seen that Isande Barrasca , a Drill Technician from the Engineering Department is an outlier. His only close contact to the rest of employees is Hideki Cocinaro , a Site Controller from the Security Department.
Similarly, Sten Sanjorge Jr. , IT Technician from the Information Technology Department, have minimal interactions with other employees and seems not well connected within the company.
The heatmap below visualizes the number of interactions between employees.
employee_interact1 <- full_join(employee_edges,
employee_nodes,
by = (c("from" = "id"))) %>%
rename(SenderDepartment = group) %>%
rename(SenderTitle = Title)
employee_interact2 <- full_join(employee_interact1,
employee_nodes,
by = (c("to" = "id"))) %>%
rename(ReceiverDepartment = group) %>%
rename(ReceiverTitle = Title) %>%
rename(Sender = from) %>%
rename(Receiver = to)
employee_interaction <- ggplot(data = employee_interact2,
aes(x=Sender, y=Receiver,
fill = weight,
text = paste("Sender :", Sender,"\n",
"Sender Department:", SenderDepartment, "\n",
"Sender Title:", SenderTitle, "\n",
"\n",
"Receiver", Receiver,"\n",
"Receiver Department:", ReceiverDepartment, "\n",
"Receiver Title:", ReceiverTitle, "\n",
"\n",
"Number of Meetings", weight))) +
geom_tile()+
scale_fill_gradient(low = "lightsteelblue1", high = "royalblue4") +
ggtitle("GAStech Personnel Relationship based on number of Interactions") +
labs(x = "Sender Employee", y = "Receiver Employee") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 90))
ggplotly(employee_interaction, tooltip = "text")
The highest number of meetings among GAStech Personnel are truck drivers with 23 interactions. Employee names are set to NA since the CarID is not identified. The second highest number of meetings is from Bertrand Ovan, Group Manager of Facilities department with 14 meetings.
The third highest number of meetings is from Ingrid Barranco, SVP/CFO from Executive department with 12 meetings.
Q5: Evidence of Suspicious Activities
Do you see evidence of suspicious activity? Identify 1- 10 locations where you believe the suspicious activity is occurring, and why.
Building on the POI network with employee interactions from Question 4, covert the gps coordinates to simple feature and plot it in the tourist map.
gps_poi_network_sf <- st_as_sf(gps_poi_network,
coords = c("long", "lat"),
crs= 4326)
gps_poi_network_sf
Simple feature collection with 773 features and 13 fields
Geometry type: POINT
Dimension: XY
Bounding box: xmin: 24.85088 ymin: 36.04802 xmax: 24.90814 ymax: 36.08962
Geodetic CRS: WGS 84
# A tibble: 773 x 14
timestamp CarID date day hour Deparment
* <dttm> <fct> <dttm> <ord> <int> <chr>
1 2014-01-06 07:34:01 10 2014-01-06 00:00:00 Mon 7 Executive
2 2014-01-06 07:44:01 12 2014-01-06 00:00:00 Mon 7 Security
3 2014-01-06 07:59:01 8 2014-01-06 00:00:00 Mon 7 Informat~
4 2014-01-06 08:03:01 13 2014-01-06 00:00:00 Mon 8 Security
5 2014-01-06 08:14:01 30 2014-01-06 00:00:00 Mon 8 Security
6 2014-01-06 08:17:01 22 2014-01-06 00:00:00 Mon 8 Security
7 2014-01-06 11:46:01 16 2014-01-06 00:00:00 Mon 11 Security
8 2014-01-06 11:46:01 107 2014-01-06 00:00:00 Mon 11 <NA>
9 2014-01-06 11:47:01 33 2014-01-06 00:00:00 Mon 11 Engineer~
10 2014-01-06 11:52:01 10 2014-01-06 00:00:00 Mon 11 Executive
# ... with 763 more rows, and 8 more variables: Title <chr>,
# FullName <chr>, poi_diff <drtn>, poi <lgl>, lat_diff <dbl>,
# long_diff <dbl>, close_contact <lgl>, geometry <POINT [°]>gps_poi_network_points <- gps_poi_network_sf %>%
select(timestamp,
CarID,
Deparment,
Title,
FullName,
date,
hour)
tmap_mode("view")
tm_shape(bgmap) +
tm_rgb(bgmap, r = 1,g = 2,b = 3,
alpha = NA,
saturation = 1,
interpolate = TRUE,
max.value = 255) +
tm_shape(gps_poi_network_points) +
tm_dots(col = 'red', border.col = 'black', size = 1, alpha = 0.5, jitter = .8) +
tm_facets(by = "date", ncol = 1)
1. Frydos Autosupply n More
This is the suspicious place because of the 10,000 spent on 2014-01-13. Additionally, members of the Security department frequently visit this place:
2. Spetsons Park
On January 07, 2014, 3:25, Isia Vann visited this place which is very unusual especially in the wee hours of the morning.
3. CEO’s house
On January 10, 2014, 23:23, Axel Calzas visited the place where the CEO is residing, he was followed by Kanon Herrero at arond 23:33 After a few hours, Felix Balas can also be seen around the vicinity On January 11, 2014, 00:25.
Photo Evidences|
4. Chostus Hotel
On January 08, 2014, around 13:00, both Brand Tempestad and Elsa Orilla were around the vicinity of hotel. This is unusual because it is still office hours on a weekday and they were in a hotel.
5. Warehouse near Sannan Park
On January 10, 2014, 22:20, Minke Mies visited this place. He also frequently visits the location around the Frydos Autosupply n More. 
5. Conclusion
This assignment attempts to solve the 2021 VAST Challenge: Mini-Challenge 2 by applying different visual analytics concepts, methods, and techniques.
The interactive bar chart was used to identity the most popular locations which is Katerina’s Cafe while interactive heatmap was used to determine the day and time when GAStech employees visit the place. The interactive boxplot was used to perform initial analysis of outliers while plot_anomaly_diagnostics function was used to diagnose unusual purchases particularly the 10,000 transaction in Frydos Autosupply n More.
Interactive heatmap was also used to assess the anomalies where it shows the transactions with the missing credit card and loyalty card data. Adding the gps and car data and plotting the movement path using tmap, 4 employees were identified who may be involved in the suspicious transactions in Frydos Autosupply n More.
An approach was proposed to determine the owners of the loyalty and credit card data. It involves mapping the credit card transaction purchases timestamp against the interactive ‘Point of Interest’ map.
Similar to POI, relationship among the GASTech personnel was establish based on their ‘close contact’ with each other where they are meeting at the same place and at the same time. An interactive network graph and heatmap were used to show the GAStech personel relationships based on the number of their interactions.
Synthesizing the information from all the questions 1 to 4 and using interactive POI maps, several locations where identified to be the place where suspicious activities are happening.
Using relevant R data visualisation and data analysis packages, the previous submissions from 2014 VAST Challenge were enhanced by adding interactive features and making the visualisation reproducible.
Finally, this assignment can still be further improved by using RShiny App and have a more friendly user interface to perform the investigation.
6. References
VAST Challenge 2014: MC2 - Patterns of Life Analysis Benchmark Repository
Whiting, Mark & Cook, Kristin & Grinstein, Georges & Liggett, Kristen & Cooper, Michael & Fallon, John & Morin, Marc. (2014). VAST challenge 2014: The Kronos incident